home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr10 / rmast40.zip / DEMO3.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-12  |  2KB  |  117 lines
  1. (* ************************************************************* *)
  2. (* demo3.pas For Turbo Pascal - Demonstrates how to set palettes *)
  3. (*                                                               *)
  4. (*                                                               *)
  5. (* Use the RM to create palette tables.                          *)
  6. (*                                                               *)
  7. (* NOTE: The BGI setrgbpalette function does not work properly.  *)
  8. (*       Use the setrgb function that is provided here.          *)
  9. (* ************************************************************* *)
  10.  
  11. Program Demo3;
  12.    uses dos,crt,graph;
  13.  
  14.  
  15. {$F+}
  16. Function DetectVGA256 : integer;
  17. begin
  18.     DetectVGA256:=0;
  19. end;
  20. {$F-}
  21.  
  22. Procedure setVGA256;
  23. Var
  24.  gd,gm : Integer;
  25. begin
  26.  gd:=InstallUserDriver('svga256',@detectvga256);
  27.  gd:=Detect;
  28.  Initgraph(gd,gm,'');
  29. end;
  30.  
  31. Procedure setvga16;
  32. var
  33.  gd,gm : integer;
  34. begin
  35.  gd:=VGA;
  36.  gm:=VGAHI;
  37.  
  38.  initgraph(gd, gm, '');
  39. end;
  40.  
  41. Procedure SetRGB(c, r, g, b : integer);
  42. var
  43.   reg : registers;
  44. begin
  45. if ((getmaxcolor=15) AND (c<16)) then
  46. begin
  47.  reg.ah := $10;
  48.  reg.al := 0;
  49.  reg.bl := c;
  50.  reg.bh := c;
  51.  intr($10,reg);
  52. end;
  53.  reg.ah := $10;
  54.  reg.al := $10;
  55.  reg.bx := c;
  56.  reg.dh := r;
  57.  reg.ch := g;
  58.  reg.cl := b;
  59.  intr($10,reg);
  60. end;
  61.  
  62. Procedure SetNewPalette;
  63. Const
  64. (* Pascal Palette Source, 16 Colors (RGB)  *)
  65.  
  66. Pal : Array[1..48] of Byte = (
  67.           $00,$00,$00,$3F,$15,$15,$3F,$18,$18,$3F,$1B,$1B,
  68.           $3F,$1E,$1E,$3F,$21,$21,$3F,$24,$24,$3F,$27,$27,
  69.           $3F,$2A,$2A,$3F,$2D,$2D,$3F,$30,$30,$3F,$33,$33,
  70.           $3F,$36,$36,$3F,$39,$39,$3F,$3C,$3C,$3F,$3F,$3F);
  71. var
  72.  i : integer;
  73. begin
  74.  For i:=0 to 15 do
  75.  begin
  76.   setrgb(i,Pal[i*3+1],Pal[i*3+2],Pal[i*3+3]);
  77.  end;
  78. end;
  79.  
  80. Procedure DrawBars;
  81. var
  82.  i : integer;
  83.  barwidth,barheight : integer;
  84.  numcolors : integer;
  85. begin
  86.  numcolors:=getmaxcolor+1;
  87.  barwidth:=getmaxx DIV numcolors;
  88.  barheight:=getmaxy DIV 2;
  89.  
  90.  for i:=0 to numcolors do
  91.  begin
  92.    setfillstyle(Solidfill,i);
  93.    bar(i*barwidth,0,i*barwidth+barwidth,barheight);
  94.  end;
  95. end;
  96.  
  97. Procedure WaitForKey;
  98. var
  99.  ch : char;
  100. begin
  101.  repeat until keypressed;
  102.  ch:=readkey;
  103. end;
  104.  
  105. begin
  106.   setvga16;          (* replace with setvga256 for 256 color palettes *)
  107.  
  108.   drawbars;
  109.   waitforkey;
  110.   setnewpalette;
  111.   setcolor(15);
  112.   outtextxy(getmaxx div 2-50,getmaxy div 2+50,'NEW PALETTE');
  113.  
  114.   waitforkey;
  115.   closegraph;
  116. end.
  117.